00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES. LOAD WITH MSFAIL.FAI
00200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /XXX/LK,LP,JY
00300		COMMON/XRN/RN(2000),XN(2000)
00400		COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
00500		COMMON/POSI/STFF(-3/4),JJ2,PQ/PTR/PWDS(250),L,LL,I,IX
00600	      DIMENSION IV(78),LIST(200),
00700		1XWDS(250)
00800	C**** RN MIGHT HAVE TO BE 4000 ******
00900		COMMON /PX/POS,SX
01000		DATA FIB/.5/
01100		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01200		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(LIST,IV)
01300	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
01400	
01500	14	JT=0
01600		JR=0
01700		REWIND 1
01800	1	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
01900		TYPE 1
02000		ACCEPT 2,NAMX
02100	213	IF(LOOKD(NAMX).GE.0)GO TO 13
02200		TYPE 88,NAMX
02300		ACCEPT 2,L
02400		IF(L.EQ.'N')GO TO 14
02500	88	FORMAT(' WRITE OVER FILE ',A5,'????  '$)
02600	13	XWDS(1)=1
02700		JRH=0 
02800	C  FOR REST COLLECTION
02900		IF(JT.EQ.0)RM=0
03000		L=1
03100	CCC	JX=0
03200		LX=1
03300	C  LX IS START OF EACH SECTION, L IS END.
03400		LP=1
03500		IF(JT.NE.0)GO TO 87
03600	CJ44	FORMAT(' TYPE TOP OUTPUT STAFF #  ',$)
03700	CJ	TYPE 44
03800	CJ	ACCEPT 5,RS
03900	CJ	RSX=RS
04000		RS=3
04100	C  SAVE UPPER STAFF NUM FOR NEXT FILE.
04200		TYPE 144
04300	144	FORMAT(' STAFF SIZE = '$)
04400		ACCEPT 5,STFSZ
04500	C  NON-ZERO STFSZ WILL CHANGE P5 IN ALL USED STAVES.
04600	10	IF(JT.EQ.0)GO TO 83
04700	87	NAME=NAME+2
04800		GO TO 84
04900	86	FORMAT(1XA5)
05000	3	FORMAT(' TYPE INPUT NAME, (CONT), (NOBAR)  ',$)
05100	83	TYPE 3
05200		ACCEPT 2,NAME,JT,NBAR
05300	C  TYPE ANY NUMBER AFTER NAME AND IT WILL GO TO NEXT LETTER IN ALPH.
05400		NAMZ=NAME
05500		IF(NBAR.NE.0)NBAR=-1
05600	C  ANY THIRD NUM. SUPPRESSES SCORE BARLINE FEATURE
05700	CC84	LK=LP
05800	84	IF(LOOKD(NAME))GO TO 284
05900		NAME=NAMZ+256
06000		IF(LOOKD(NAME).GE.0)GO TO 201
06100		NAMZ=NAME
06200	C  FOUND NO MORE TO READ
06300	284	TYPE 86,NAME
06400		JZ=0
06500		IF(RM.NE.0)GO TO 77
06600		RM=-1
06700	4	FORMAT(' TYPE INST NAME, (RESPC?) '$)
06800		TYPE 4
06900		ACCEPT 2,RNAM,NRS
07000	C  TYPE ANY NUM AFTER INS. NAME TO STOP RHYTH RESPACING.
07100		IF(RNAM.GT.0)REREAD 5,SN
07200		IF(INM.EQ.'99')GO TO 20
07300	CC	K=SN/100.
07400		TYPE 46
07500	46	FORMAT(' TRANS. NUM. -- '$)
07600		ACCEPT 5,TR
07700	C  TRANSPOSITION BY STEPS
07800		IF(TR.GE.99)GO TO 83
07900	77	REWIND 21
08000	177	CALL IFILE(21,NAME)
08100		KA=LX
08200	C  LX IS START OF PWDS ARRAY THIS TIME
08300		KB=L
08400		LP=XWDS(L)
08500		LK=LP
08600		KP=LP
08700	C  LP IS START OF RN ARRAY THIS TIME
08800		READ(21),ITEM,I,
08900		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
09000		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
09100		DO 45 K=1,ITEM
09200		J=PWDS(K)
09300		IF(RN(J+1).NE.8)GO TO 45
09400		IF(RNAM)GO TO 145
09500		IF(RN(J+2).EQ.SN)GO TO 8 
09600		GO TO 45
09700	145	R9=RN(J+9)
09800		TYPE 86,R9
09900		IF(R9.NE.RNAM)GO TO 45
10000		SN=RN(J+2)
10100		IF(STFSZ.EQ.0)STFSZ=RSTFAC(IFIX(SN))
10200	C  FOUND THE STAFF
10300		GO TO 8
10400	45	CONTINUE
10500	C??	L=JX
10600	C??	LP=JY
10700		TYPE 16
10800	16	FORMAT(' INST. NOT FOUND'/)
10900		GO TO 10
11000	8	SIG=200
11100	C  FOR TRANSP. SECTION.
11200		RN(J+8)=0
11300	C REMOVES VERTICAL SPACER, IF ANY
11310		IF(RS.EQ.0)RN(J+8)=2.95
11320	C  PUTS ONE IN IF THIS IS LAST ONE FOR THIS FILE.
11400		DO 6 K=1,ITEM
11500		J=PWDS(K)
11600		R=RN(J+1)
11700		IF(R.NE.10)GO TO 800
11800		IF(RN(J).LT.4)GO TO 80
11900		IF(RN(J+6).GT.1.3)GO TO 6
12000	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
12100		IF(RN(J).LT.6)GO TO 80
12200	C  FOUND A NUM. IN BOX ↓↓
12300	2182	RN(J+2)=SN
12400		GO TO 81
12500	800	IF(R.NE.4)GO TO 80
12600		IF(NBAR)GO TO 80
12700		IF(RN(J).NE.2)GO TO 182
12800	C  FOUND A BAR LINE
12900		KZ=RN(J+4)/100.
13000		RN(J+4)=1.+KZ*100.
13100	C  KZ IS FOR THICK BARS.
13200		R=RN(J+3)
13300		DO 82 KY=K+1,ITEM
13400		KZ=PWDS(KY)
13500		IF(RN(KZ+1).NE.4)GO TO 82
13600		IF(RN(KZ).NE.2)GO TO 82
13700	C  AVOIDS DUPLICATE BARS.
13800		IF(ABS(R-RN(KZ+3)).GT..5)GO TO 82	
13900		RN(KZ+2)=99
14000		RN(KZ+1)=0
14100	82	CONTINUE
14200		GO TO 81
14300	182	IF(RN(J).LT.5)GO TO 80
14400		IF(RN(J+7).GE.3)GO TO 6
14500	C  SKIP HEAVY BRACKETS.
14600	80	IF(R.NE.16)GO TO 1182
14700		IF(RN(J+5).LT.1.1)GO TO 1182
14800	C  PUTS IN ALL TEXT ≥1.1 SIZE
14900		GO TO 2182
15000	1182	IF(RN(J+2).NE.SN)GO TO 6
15100		IF(RN(J+1).NE.8)GO TO 81
15200		IF(RN(J).LT.2)GO TO 81
15300	C  CAN'T CHANGE 0 SIZE TO OTHER YET.
15400		RN(J+4)=0
15500	C  SETS VERT. POS. OF STAFF TO 0.  NEXT IS FOR P5.
15600		IF(RN(J).LT.3)GO TO 81
15700		RN(J+5)=STFSZ
15800	CC85	JZ=-1
15900	81	JA=PWDS(K+1)
16000		DO 7 KY=J,JA-1
16100		XN(LK)=RN(KY)
16200	7	LK=LK+1
16300		IF(L.GE.200)GO TO 150
16400		IF(LK.LE.1700)GO TO 50
16500	150	TYPE 9
16520		L=LX
16530		NAME=NAME-2
16600		GO TO 20
16700	9	FORMAT(' NO ROOM FOR THIS ONE, FILE ENDED.')
16800	50	R=XN(LP+1)
16900		XN(LP+2)=RS
17000		L=L+1
17100		LP=LK
17200		XWDS(L)=LP
17300	6	CONTINUE
17400	CCC17	JX=L
17500	CCC	JY=LP
17600	17	IF(NRS.NE.0)GO TO 200
17700	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
17800		M=LX+1
17900		J=XWDS(LX)
18000		PWDS(LX)=XWDS(LX)
18100		I=LX
18200		DO 243 K=LX,L-1
18300		LB=XWDS(K)+1
18400		IF(XN(LB).NE.16)GO TO 243
18500		IF(XN(LB-1).LT.8)GO TO 243
18600		JL=XWDS(K-1)
18700	244	XN(LB+2)=XN(JL+3)
18800	C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
18900	C  FOR SPACING PROBLEMS BELOW.
19000	243	CONTINUE
19100	24	RA=10000.
19200	C  POSITION
19300		DO 21 K=LX,L-1
19400		JL=XWDS(K)+3
19500		R=XN(JL)
19600		IF(R.EQ.10000)GO TO 21
19700	CC	IF(XN(JL-2).NE.16)GO TO 241
19800	CJ  WILL SORT ONLY NOTES, RESTS, CLEFS, BARS.
19900	CC	I=K
20000	CC	GO TO 242
20100	241	IF(ABS(R-RA).GT..1)GO TO 240
20200		R=RA
20300		XN(JL)=R
20400	C  PUT IN HERE MULTI-VOICE TRAP
20500		GO TO 21
20600	240	IF(R.GT.RA)GO TO 21
20700	C  LINES THEM UP
20800		I=K
20900		RA=R
21000	21	CONTINUE
21100		IF(RA.EQ.10000)GO TO 23
21200	C  JUMP IF ALL SORTED
21300	242	JL=XWDS(I)
21400		LA=JL
21500		N=XN(JL)+3
21600	C  NEXT POINTER
21700		PWDS(M)=PWDS(M-1)+N
21800		M=M+1
21900		DO 22 K=J,J+N-1
22000		RN(K)=XN(JL)
22100	22	JL=JL+1
22200		XN(LA+3)=10000
22300	C  PUT IT ASIDE
22400		J=N+J
22500		GO TO 24
22600	23	CALL RESTS
22700	
22800	C JA=0=NO RESTS; -1=BEG. AND END WITH NOTES; -2=ALL RESTS;
22900	C  -3=BEG. AND END WITH REST; 1=START NOTES, END REST;
23000	C  2 OR 3 = START REST, END NOTES.
23100		IF(JRH.EQ.0)GO TO 123
23200		IF(JRH.GE.2)GO TO 123
23300		IF(JRH.EQ.-1)GO TO 123
23400	C  JUMP IF LAST LINE ENDED WITH NOTES
23500		IF(JA.EQ.-1)GO TO 123
23600		IF(JA.NE.1)CALL REST2(KA,KB,JRH,KP,XWDS)
23700	C CALL IF LAST ITEM ON LINE IS REST.
23800	CC	IF(L.NE.KB)GO TO 123
23900		IF(L.EQ.KB)GO TO 10
24000	CCC	JX=LX
24100	CC	JY=LP
24200	CCC	LP=KP
24300	C  GO BACK IF THIS LINE ABSORBED INTO PREVIOUS.
24400	CCC	GO TO 10
24500	123	CALL DELE
24600	C  DELETES UN-NEEDED THINGS.
24700		LB=LX
24800		JFST=0
24900		POS=0
25000		JRH=JA
25100	C  SAVES REST SITUATION FOR NEXT TIME AROUND
25200		R5X=0
25300	C  NEXT RECONSTITUTES RHYTHM
25400	25	N=PWDS(LB)
25500		R=RN(N+1)
25600		IF(TR.EQ.0)GO TO 51
25700		IF(R.EQ.1)GO TO 52
25800		IF(R.EQ.5)GO TO 52
25900		IF(R.EQ.6)GO TO 52
26000		IF(R.EQ.17)GO TO 117
26100	51	IF(R.LE.4)GO TO 430
26200		IF(R.LT.17)GO TO 30
26300	C LOOKS FOR 17 AND 18, KSIG AND METER.
26400	430	IF(R.NE.1)GO TO 230
26500		IF(RN(N).LT.7)GO TO 30 
26600		IF(RN(N+9))GO TO 30
26700	C SKIPS NON-LEDGER LINE NOTES.
26800		GO TO 530
26900	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS, AND BARS,CLEFS
27000	230	IF(R.NE.2)GO TO 330
27100		IF(RN(N).LT.5)GO TO 30
27200	C JUMP IF NO RHYTH VALUE FOUND IN P7 (P9 FOR NOTES)
27300	530	IF(JFST.NE.0)GO TO 130
27400		JFST=LB+1
27500		POS=RN(N+3)
27600	C  POS IS LEFTMOST NOTE OR REST
27700		GO TO 130
27800	330	IF(JFST.EQ.0)GO TO 30
27900	C  ONLY LOOKS AT ITEMS AFTER FIRST N0TE OR REST.
28000		IF(R.NE.4)GO TO 130
28100		IF(RN(N).NE.2)GO TO 30
28200	130	IF(RCLEF(RN(N)))GO TO 30
28300	CJ SKIPS NON-CLEFS
28400		S=RN(N+3)
28500		LA=LB
28600	26	LA=LA+1
28700		IF(LA.GE.L)GO TO 30
28800	C  FIND NEXT IMPORTANT ITEM
28900		NA=PWDS(LA)
29000		RR=RN(NA+1)
29100		IF(RR.LE.4)GO TO 134
29200		IF(RR.LT.17)GO TO 26
29300	134	IF(RR.NE.4)GO TO 34
29400		IF(RN(NA).NE.2)GO TO 26
29500	C  USES ONLY NOTES, RESTS, BARS, CLEFS
29600	34	IF(RCLEF(RN(NA)))GO TO 26
29700	CJ SKIPS NON-CLEFS
29800		RX=RN(NA+3)
29900	C  POSITION OF NEXT ITEM
30000		IF(S.EQ.RX)GO TO 26
30100		A=RX-1
30150	C  WAS -2 ABOVE
30200		IF(A.LT.S)A=S+.5
30300	C  SPACING WILL BEGIN NEARBY
30400		IF(R.LT.3)GO TO 235
30500		IF(R.GE.17)P=4.
30600	C  PUT IN FOR LARGE KSIGS LATER.
30700		IF(R.EQ.4)P=2.
30800		IF(R.EQ.3)P=6.
30900		IF(RN(NA+5).GE.100.)P=5.
31000	C SPACE FOR BARS, KSIG, METERS, CLEFS (LAST FOR MINI-CLEF)
31100		IF(RR.EQ.17)P=P+3.
31200	C  IF NEXT(RR) IS KSIG, ADD SPACE.
31300		GO TO 335
31400	235	K=9
31500		IF(R.EQ.2)K=7
31600		P=RN(N+K)
31700		P=P+(.125-P)*FIB
31800	135	P=P*15.
31900	C  FINDS RHYTH IN P9 OR P7(REST)
32000	C  IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
32100		IF(P)GO TO 30
32200	C  SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
32300	335	SX=S+P-RX
32400		R5X=R5X+SX
32500	C  SPACE DIFFERENCE
32505	
32600	35	DO 29 K=JFST,L
32700	CC	RR=SX
32800		NZ=PWDS(K)+3
32900		RA=RN(NZ)
33000	
33050		IF(K.LE.LB)GO TO 2900
33075	C DON'T LOOK AT NOTES AND RESTS UNLESS NEEDED
33100	CC	IF(RA.LT.A)RR=RR*(RA-S)/(A-S)
33200	CC	IF(RA.GT.S)RN(NZ)=RA+RR	
33210		RR=RA+SX
33220		IF(RR.LT.S)GO TO 2900
33230	C  SO IT WON'T MOVE TOO FAR TO LEFT
33250		RN(NZ)=RR
33300	CC	RR=SX
33400	C  A=BASIC POS. AT THIS TIME.
33500	2900	R=RN(NZ-2)
33600		IF(R4567(R))GO TO 29
33700		NZ=NZ-3
33800		IF(RN(NZ).EQ.2)GO TO 29
33900		RB=RN(NZ+6)
34000	CC	IF(RB.LT.A)RR=RR*(RB-S)/(A-S)
34100	CC	IF(RB.GT.S)RN(NZ+6)=RB+RR
34110		RR=RB+SX
34120		IF(RR.LT.S)GO TO 29
34150		IF(RB.GE.S)RN(NZ+6)=RR
34200	CC	IF(R.EQ.6)CALL BMQ(RN,NZ,A)
34205		IF(R.NE.6)GO TO 29
34210		RR=RN(NZ)
34215		IF(RR.LT.7)GO TO 29
34220		KB=9+NZ
34225		IF(RR.NE.7)GO TO 2901
34230	2902	IF(RN(NZ+8).NE.0)GO TO 2903
34235		GO TO 29
34240	2901	IF(RN(NZ+10).EQ.0)GO TO 2902
34245		IF(RN(NZ+10).LT.30)GO TO 2903
34250		KB=KB-1
34255	2903	RB=RN(KB)
34260		RR=RB+SX
34265		IF(RR.GE.S)RN(KB)=RR
34270	C  ALL THIS FOR INNER BEAMS
34300	29	CONTINUE
34400	30	LB=LB+1
34500		IF(LB.LT.L)GO TO 25
34600	C  GO BACK IF MORE SPACING TO DO
34700		P8=0
34800		LL=0
34900		IF(XLFT.EQ.0)GO TO 600
35000	C  NEXT MOVES LEFT SIDE OF STAFF TO ZERO
35100		R5=POS-.5
35200		R7=RS
35300		R8=-XLFT
35400		R4=-101
35500		R9=0
35600		CALL PTMOVE
35700	CCC	R8=POS-XLFT
35800		R4=POS
35900		N=2
35905		IF(JFST.GT.0)GO TO 607
35910		TYPE 1232
35940		GO TO 500
35970	1232	FORMAT(' NO RHYTHM GIVEN THIS LINE')
36000	607	NA=PWDS(JFST-N)
36100	606	R8=RN(NA+3)+1.5
36200		IF(R8.LT.POS)GO TO 600
36300		N=N+1
36400		GO TO 607
36500	C  THIS SHOULD PUT 1ST NOTE OR REST JUST TO RIGHT OF OTHER STUFF.
36600	600	R5=R5X+200.00001
36700	
36800	C  R5 HAS SpACE CHANGE (SEE 35-1)
36900		R9=200
37000		R7=RS
37100		IF(LX.EQ.1)GO TO 300
37200		DO 301 K=IFIX(PWDS(1)),IFIX(PWDS(LX))-1
37300	301	RN(K)=0
37400		DO 302 K=IFIX(PWDS(L)),2000
37500	302	RN(K)=0
37600	C  CLEARS CONFUSION IN MOVER.!!!
37700	300	CALL PTMOVE
37800		RSTFAC(IFIX(RS))=STFSZ
37900		R4=0
38000		R5=200.
38100		LL='J'
38200	400	CALL PTMOVE
38300	C TO JUSTIFY IT.
38400	
38500	500	DO 32 K=IFIX(PWDS(LX)),IFIX(PWDS(L))
38600	32	XN(K)=RN(K)
38700		DO 33 K=LX,L
38800		LL=PWDS(K)
38900		R=XN(LL+1)
39000		RR=XN(LL)
39100		IF(R.NE.2)GO TO 333
39200	C  NEXT FOR RESTS
39300		IF(RR.LT.6)GO TO 33
39400		R=XN(LL+8)
39500		IF(R.LE.0)GO TO 33
39600	C NEXT FOR CENTERING WHOLE REST
39700		KQ=K-1
39800	1333	LA=PWDS(KQ)
39900		IF(XN(LA+1).NE.16)GO TO 2333
40000	C SKIP CODE 16.
40100		KQ=KQ-1
40200		GO TO 1333
40300	2333	R=XN(LA+3)
40400		KQ=K+1
40500	3333	LA=PWDS(KQ)
40600		IF(XN(LA+1).NE.16)GO TO 4333
40700		KQ=KQ+1
40800		GO TO 3333
40900	4333	RR=XN(LA+3)
41000	CC	R=XN(IFIX(PWDS(K-1))+3)
41100	CC	RR=XN(IFIX(PWDS(K+1))+3)
41200		XN(LL+3)=R+(RR-R)/2.-.8*STFSZ
41300		GO TO 33
41400	333	IF(R.NE.16)GO TO 33
41500		IF(RR.LT.8)GO TO 33
41600		NZ=PWDS(K-1)
41700		IF(XN(NZ+1).NE.16)GO TO 33
41800	C  NEXT FOR CONTINUING TEXT
41900		XN(LL+3)=XN(NZ+3)+XN(NZ+9)*STFSZ*XN(NZ+5)
42000	33	XWDS(K)=PWDS(K)
42100	C  ALL DONE
42200	C****↑↑↑↑↑↑  RHYTH. RESET ↑↑↑↑↑↑↑↑↑↑↑
42300	200	LX=L
42400	C  LX IS START OF EACH SECTION, L IS END.
42500	
42600		RS=RS-1
42700	CJ	IF(RS.GT.-4)GO TO 10
42800		IF(RS.GT.-1)GO TO 10
42900	CCC20	L=JX-1
43000	20	LL=XWDS(L)
43100		L=L-1
43200		IF(L.LE.0)CALL EXIT
43210		IF(RS)GO TO 115
43220		RS=RS+1
43230		DO 1115 K=1,L
43240		J=XWDS(K)+2
43250	1115	XN(J)=XN(J)-RS
43260	C MOVES ALL ITEMS DOWN RS STAVES.
43300	115	J=1
43400		CALL OFILE(1,NAMX)
43500		WRITE(1),L,LL,
43600		1 (XWDS(K),K=1,L+1),(XN(K),K=1,LL-1),J,J,J,J,RSTFAC,STFF,IV,STFF
43700	C  STUFF ON THE END IS FOR FORTRAN IO BUG.
43800		TYPE 86,NAMX
43900	15	END FILE 1
44000		IF(JT.EQ.0)CALL EXIT
44100		NAMX=NAMX+2
44200		TYPE 86,NAMX
44300	CJ	RS=RSX
44400		RS=3
44500		GO TO 213
44600	201	JT=0
44700		GO TO 20
44800	2	FORMAT(A5,2I)
44900	5	FORMAT(5F)
45000	
45100	
45200	52	A=RN(N+4)
45300		RN(N+4)=A+TR
45400	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
45500		X=RN(N+5)
45600		IF(RN(N+1).EQ.1)GO TO 11
45700	C  COULD ADD STEM REVERSE HERE.
45800		RN(N+5)=X+TR
45900		GO TO 51
46000	11	A=AMOD(A,100.)
46100		IF(TR.NE.4)GO TO 1101
46200		IF(AMOD(A,7.0).EQ.0)GO TO 101
46300	1101	IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
46400	C  NEXT IS FOR Bb TRANSP.
46500		B=AMOD(A+7.0,7.0)
46600		IF(B.EQ.0)GO TO 101
46700		IF(B.NE.3)GO TO 51
46800	C  FINDS ORIG. E OR B
46900	101	M=AMOD(X,10.0)
47000	C  FINDS ACCID.
47100		X=X-M
47200	C  STEM DIR. AND DECI.
47300		B=3.
47400	C CHANGES FLAT TO NATURAL SIGN.
47500		IF(M.NE.0)GO TO 118
47600		IF(SIG.NE.200)GO TO 51
47700	C  GO BACK IF A KEY SIG. IS PRESENT
47800	118	IF(M.EQ.3)B=2
47900	C  NO PROVISION YET FOR ## OR bb
48000	2101	RN(N+5)=X+B
48100		GO TO 51
48200	117	SIG=RN(N+5)
48300		IF(TR.EQ.1)SIG=SIG+2
48400		IF(TR.EQ.4)SIG=SIG+1
48500	C CHANGE KSIG FOR Bb AND F INSTS.  ADD CHECK-UP ABOVE LATER.
48600	C  MAKES NATURALS IF CHANGED TO NO KSIG (I.E. =0)
48700		IF(SIG.NE.0)GO TO 217
48800		IF(TR.EQ.1)SIG=-102
48900		IF(TR.EQ.3)SIG=-101
49000	217	RN(N+5)=SIG
49100		GO TO 51
49200		END